www.gusucode.com > HCONLY站长管理助手 V1.3 > HCONLY站长管理助手 V1.3\code\tools\seo\cnrank.asp
<% If request("d")="" Then Response.Redirect "cnrank.asp?d=173158.net" End If wd=Request("d") cnrankUrl="http://tool.alimama.com/gettext.php?q=http://tool.alimama.com/chinarank/"&wd&"/" TempStr= getHTTPPage(cnrankUrl) dim cnrankWebSite set reg=new Regexp reg.Multiline=True reg.Global=Flase reg.IgnoreCase=true reg.Pattern="上综合排名第((.|\n)*?)位网站" Set matches = reg.execute(TempStr) For Each match1 in matches cnrankWebSite=match1.Value Next Set matches = Nothing Set reg = Nothing cnrankWebSite=Replace(cnrankWebSite,"上综合排名第","") cnrankWebSite=Replace(cnrankWebSite,"位网站","") cnrankWebSite=Replace(cnrankWebSite,"","") cnrankWebSite=Replace(cnrankWebSite,",","") cnrankWebSite=Replace(cnrankWebSite," ","") %> <html><head> <title><%=wd%>在ChinaRank中国网站排名的排名情况|义乌站长之家 173158.net</title> <meta name="robots" content="noindex,nofollow" /> <meta http-equiv="Content-Type" content="text/html; charset=gb2312" /> <meta content="Copyright 2007 173158.net" name="Copyright" /> <meta content="Hans He" name="Author"> <style type="text/css"> body{ margin:0px;COLOR:#529252;FONT-SIZE:11px;FONT-weight:bold;TEXT-DECORATION: none; font-family:"Georgia", "Arial";} A:link,A:visited { COLOR: #0066CC; FONT-SIZE: 12px; font-weight:bold;TEXT-DECORATION:underline;} A:active,A:hover{COLOR:#FF3300;FONT-SIZE: 12px; font-weight:bold;TEXT-DECORATION: underline;} A.alexarank:link,A.alexarank:visited { COLOR:#529252;FONT-SIZE:11px;FONT-weight:bold;TEXT-DECORATION: none; font-family:"Georgia", "Arial";} A.alexarank:hover,A.alexarank:active { COLOR:#FF3300;FONT-SIZE:11px;FONT-weight:bold;TEXT-DECORATION: none; font-family:"Georgia", "Arial";} </style></head><body leftmargin=0 topmargin=0 bgcolor="#FFFFFF"> <div align="center"> <% If Request("d")<>"" Then Response.Write ("<a href=""http://www.chinarank.org.cn/overview/Info.do?url="&wd&""" target=""_blank"" title="""&cnrankWebSite&" "&wd&""">"&cnrankWebSite&"</a>") End If %> </div></body></html> <% Function getHTTPPage(Path) t = GetBody(Path) getHTTPPage=BytesToBstr(t,"UTF-8") End function Function GetBody(url) on error resume next Set Retrieval = CreateObject("Microsoft.XMLHTTP") With Retrieval .Open "Get", url, False, "", "" .Send GetBody = .ResponseBody End With Set Retrieval = Nothing End Function Function BytesToBstr(body,Cset) dim objstream set objstream = Server.CreateObject("ado"&"db.str"&"eam") objstream.Type = 1 objstream.Mode =3 objstream.Open objstream.Write body objstream.Position = 0 objstream.Type = 2 objstream.Charset = Cset BytesToBstr = objstream.ReadText objstream.Close set objstream = nothing End Function %>